
{***********************************************************}
{                                                           }
{      Luxena Class Library                                 }
{                                                           }
{      TLXRecordAllocator class                             }
{                                                           }
{      Copyright (c) 2001-2008 Luxena Software Company      }
{      http://www.luxena.com                                }
{      e-mail: support@luxena.com                           }
{                                                           }
{***********************************************************}

unit LXRecordAllocator;

{$I lx.inc}

interface

uses Classes, SysUtils;

type

{ TLXRecordAllocator }

  ELXRecordAllocatorException = class(Exception);

  TLXRecordFreeEvent = procedure (P: Pointer) of object;

  TLXRecordAllocator = class
  private
    FRecordSize: Integer;
    FPageSize: Integer;
    FPages: TList;
    FAvailableRecords: Integer;
    FCurrentRecord: PChar;
    FWholes: TList;
    FOnFreeRecord: TLXRecordFreeEvent;
  public
    constructor Create(RecordSize, PageSize: Integer);
    destructor Destroy; override;
    function AllocRecord: Pointer;
    procedure FreeRecord(P: Pointer);
    function IsValidRecord(P: Pointer): Boolean;
    property OnFreeRecord: TLXRecordFreeEvent read FOnFreeRecord write FOnFreeRecord;
  end;

implementation

uses LXConsts;


{ TLXRecordAllocator }

constructor TLXRecordAllocator.Create(RecordSize, PageSize: Integer);
begin
  if RecordSize = 0 then
    raise ELXRecordAllocatorException.Create(SInvalidRecordSize);
  if PageSize = 0 then
    raise ELXRecordAllocatorException.Create(SInvalidPageSize);
  FRecordSize := RecordSize;
  FPageSize := PageSize;
  FPages := TList.Create;
  FWholes := TList.Create;
end;

destructor TLXRecordAllocator.Destroy;
var
  I, J: Integer;
  P: PChar;
begin
  for I := 0 to FPages.Count - 1 do
  begin
    if Assigned(FOnFreeRecord) then
    begin
      P := FPages[I];
      for J := 0 to FPageSize - 1 do
      begin
        if P = FCurrentRecord then Break;
        if FWholes.IndexOf(P) < 0 then FOnFreeRecord(P);
        Inc(P, FRecordSize);
      end;
    end;
    FreeMem(FPages[I]);
  end;
  FPages.Free;
  FWholes.Free;
  inherited;
end;

function TLXRecordAllocator.AllocRecord: Pointer;
var
  Index: Integer;
begin
  if FWholes.Count = 0 then
  begin
    if FAvailableRecords = 0 then
    begin
      FCurrentRecord := AllocMem(FPageSize*FRecordSize);
      FPages.Add(FCurrentRecord);
      FAvailableRecords := FPageSize;
    end;
    Result := FCurrentRecord;
    Inc(FCurrentRecord, FRecordSize);
    Dec(FAvailableRecords);
  end else
  begin
    Index := FWholes.Count - 1;
    Result := FWholes[Index];
    FillChar(Result^, FRecordSize, 0);
    FWholes.Delete(Index);
  end;
end;

procedure TLXRecordAllocator.FreeRecord(P: Pointer);
begin
  if Assigned(FOnFreeRecord) then FOnFreeRecord(P);
  FWholes.Add(P);
end;

function TLXRecordAllocator.IsValidRecord(P: Pointer): Boolean;
var
  I: Integer;
  PageDataSize: Integer;
  Ofs: Integer;
begin
  Result := False;
  if FWholes.IndexOf(P) < 0 then
  begin
    PageDataSize := FPageSize*FRecordSize;
    for I := 0 to FPages.Count - 1 do
    begin
      Ofs := PChar(P) - FPages[I];
      if (Ofs >= 0) and (Ofs < PageDataSize) then
      begin
        Result := ((I < FPages.Count - 1) or (P <= FCurrentRecord)) and
          (Ofs mod FRecordSize = 0);
        Break;
      end;
    end;
  end;
end;


end.